home *** CD-ROM | disk | FTP | other *** search
/ Giga Games 1 / Giga Games.iso / net / usenet / volume3 / go / part03 < prev    next >
Encoding:
Internet Message Format  |  1988-03-09  |  60.7 KB

  1. Path: uunet!husc6!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request
  2. From: games-request@tekred.TEK.COM
  3. Newsgroups: comp.sources.games
  4. Subject: v03i099:  go - go board manager sources, Part03/05
  5. Message-ID: <2270@tekred.TEK.COM>
  6. Date: 9 Mar 88 17:57:05 GMT
  7. Sender: billr@tekred.TEK.COM
  8. Lines: 2210
  9. Approved: billr@tekred.TEK.COM
  10.  
  11. Submitted by: Fred Hansen <wjh+@andrew.cmu.edu>
  12. Comp.sources.games: Volume 3, Issue 99
  13. Archive-name: go/Part03
  14.  
  15.  
  16.  
  17. #! /bin/sh
  18. # This is a shell archive.  Remove anything before this line, then unpack
  19. # it by saving it into a file and typing "sh file".  To overwrite existing
  20. # files, type "sh file -c".  You can also feed this as standard input via
  21. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  22. # will see the following message at the end:
  23. #        "End of archive 3 (of 5)."
  24. # Contents:  goBoard.pas goTree.pas
  25. # Wrapped by billr@saab on Wed Mar  9 09:14:45 1988
  26. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  27. if test -f goBoard.pas -a "${1}" != "-c" ; then 
  28.   echo shar: Will not over-write existing file \"goBoard.pas\"
  29. else
  30. echo shar: Extracting \"goBoard.pas\" \(38053 characters\)
  31. sed "s/^X//" >goBoard.pas <<'END_OF_goBoard.pas'
  32. X{---------------------------------------------------------------}
  33. X{ goBoard.Pas                                                   }
  34. X{                                                               }
  35. X{ Board Image Handler for Go                                    }
  36. X{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
  37. X{                                                               }
  38. X{ Written: June 3, 1982 by Stoney Ballard                       }
  39. X{ Edit History:                                                 }
  40. X{    June  3, 1982 Started                                      }
  41. X{    June  4, 1982 Add dead group removal                       }
  42. X{    June 10, 1982 Use new go file manager                      }
  43. X{    Nov   8, 1982 Split From Go.Pas                            }
  44. X{---------------------------------------------------------------}
  45. X
  46. X
  47. Xmodule goBoard;
  48. X
  49. Xexports
  50. X
  51. Ximports goCom from goCom;
  52. Ximports screen from screen;
  53. X
  54. Xtype
  55. X  SoundType = (atari, koV, s3, s4, die, die2, die3, error);
  56. X
  57. Xexception gbFatal;
  58. X
  59. Xprocedure initGoBoard;
  60. Xprocedure clearBoard;
  61. Xprocedure addHCStones(num: integer);
  62. Xprocedure placeStone(which: sType; lx, ly, ofx, ofy, moveNum: integer);
  63. Xprocedure placeAlt(which: sType; lx, ly, ofx, ofy: integer);
  64. Xprocedure remStone(lx, ly: integer);
  65. Xprocedure showPass(which: sType);
  66. Xprocedure remPass;
  67. Xfunction passLocCur(cx, cy: integer): boolean;
  68. Xfunction bLocCur(cx, cy: integer; var lx, ly, sx, sy: integer): boolean;
  69. Xprocedure beep(sound: SoundType);
  70. Xprocedure dotStone(lx, ly: integer);
  71. Xprocedure showAllStones;
  72. Xprocedure printBoard(isDiagram: boolean);
  73. Xprocedure showCaptures;
  74. Xprocedure turnIs(who: sType);
  75. Xprocedure refreshBoard;
  76. Xprocedure putBString(x, y: integer; s: string);
  77. X
  78. Xprivate
  79. X
  80. Ximports raster from raster;
  81. Ximports io_unit from io_unit;
  82. Ximports io_others from io_others;
  83. Ximports memory from memory;
  84. Ximports fileSystem from fileSystem;
  85. Ximports perq_string from perq_string;
  86. Ximports csdx from csdx;
  87. Ximports goMgr from goMgr;
  88. Ximports goTree from goTree;
  89. Ximports goMenu from goMenu;
  90. Ximports system from system;
  91. Ximports go from go;
  92. X
  93. Xconst
  94. X  sPicC = 15;
  95. X  sPicS = 32;
  96. X  hpPicS = 10;
  97. X  hpPicC = 4;
  98. X  patchS = 40;
  99. X  patchC = 19;
  100. X  picWW = 4;
  101. X  htHeight = 4;
  102. X  htWidth = 48;
  103. X  gridWidth = 32;
  104. X  pGridWidth = 34;   { for printing }
  105. X  xMargin = boardX + gridWidth;
  106. X  yMargin = boardY + gridWidth;
  107. X  pxMargin = pBoardX + pGridWidth;
  108. X  pyMargin = pBoardY + pGridWidth;
  109. X  gridBorder = gridWidth div 2;
  110. X  pGridBorder = pGridWidth div 2;
  111. X  gridXMargin = xMargin - gridBorder;
  112. X  gridYMargin = yMargin - gridBorder;
  113. X  pGridXMargin = pxMargin - pGridBorder;
  114. X  pGridYMargin = pyMargin - pGridBorder;
  115. X  htXMargin = xMargin - gridWidth; 
  116. X  htYMargin = yMargin - gridWidth; 
  117. X  phtXMargin = pxMargin - pGridWidth; 
  118. X  phtYMargin = pyMargin - pGridWidth; 
  119. X  boardHeight = 20 * gridWidth;
  120. X  pBoardHeight = 20 * pGridWidth;
  121. X  slopSize = 2;
  122. X  lineWidth = 2;
  123. X  extraXO = pxMargin;  { 96 }
  124. X  extraYO = 768;
  125. X  pedgeBX = pxMargin;  { 96 }
  126. X  pedgeBY = pyMargin + (19 * pGridWidth);  { 672 }
  127. X  pedgeLX = pBoardX;  { 64 }
  128. X  pedgeLY = pBoardY + (19 * pGridWidth);  { 640 }
  129. X  edgeBX = xMargin;  { 96 }
  130. X  edgeBY = yMargin + (19 * GridWidth);  { 672 }
  131. X  edgeLX = BoardX;  { 64 }
  132. X  edgeLY = BoardY + (19 * GridWidth);  { 640 }
  133. X  rCmtY = pBoardX + pBoardHeight + 32;
  134. X  lCmtY = rCmtY + 8 + charHeight;
  135. X  tFntWidth = 6;
  136. X  tFntHeight = 9;
  137. X  maxSMark = 2;
  138. X
  139. Xtype
  140. X  htArray = array[0..3] of array[0..47] of integer;
  141. X  pHtArray = ^htArray;
  142. X
  143. X  beepbuf = array[0..63] of integer;
  144. X  pBeepBuf = ^BeepBuf;
  145. X
  146. Xvar
  147. X  hcDot: pPicBuf;
  148. X  htBuf: pHtArray;
  149. X  patch: array[1..9] of pPicBuf;
  150. X  StatPtr: IOStatPtr;
  151. X  statRec: IOStatus;
  152. X  sounds: array[atari..die3] of pBeepBuf;
  153. X  stones: array[sType] of pPicBuf;
  154. X  stoneCir: pPicBuf;
  155. X  stoneMarks: array[0..maxSMark] of pPicBuf;
  156. X  sysFont: fontPtr;
  157. X  goBNumFont: fontPtr;
  158. X  goSNumFont: fontPtr;
  159. X  goTNumFont: fontPtr;
  160. X  goSLetFont: fontPtr;
  161. X  printing: boolean;
  162. X  scrSavPtr: rasterPtr;
  163. X  sNumBase, sNumStart: integer;
  164. X  bigNums: boolean;
  165. X
  166. X{ merely beeps the given sound }
  167. Xprocedure beep(sound: SoundType);
  168. Xvar
  169. X  zilch: Double;
  170. X  rep, i: integer;
  171. X  savY, savB, savG, savW, savS: boolean;
  172. Xbegin { beep }
  173. X if sound = error then
  174. X   IOBeep
  175. X else
  176. X   begin
  177. X     savY := tabYellow;
  178. X     savW := tabWhite;
  179. X     savG := tabGreen;
  180. X     savB := tabBlue;
  181. X     savS := tabSwitch;
  182. X     IOSetModeTablet(offTablet);
  183. X     if sound = die then
  184. X       rep := 128 * 3
  185. X     else  
  186. X       rep := 128;
  187. X     UnitIO(Speech, RECAST(sounds[sound],IOBufPtr), IOWriteHiVol, rep,
  188. X            zilch, nil, StatPtr);
  189. X     IOSetModeTablet(relTablet);
  190. X     tabYellow := savY;
  191. X     tabWhite := savW;
  192. X     tabGreen := savG;
  193. X     tabBlue := savB;
  194. X     tabSwitch := savS;
  195. X   end;
  196. Xend { beep };
  197. X
  198. Xprocedure showCaptures;
  199. Xvar
  200. X  s: string;
  201. X
  202. X  procedure dectos(val: integer);
  203. X  var
  204. X    numC, i: integer;
  205. X    ts: string;
  206. X    c: char;
  207. X  begin { dectos }
  208. X    if val = 0 then
  209. X      s := '0'
  210. X    else
  211. X      begin
  212. X        numC := 0;
  213. X        adjust(ts, 20);
  214. X        while val <> 0 do
  215. X          begin
  216. X            numC := numC + 1;
  217. X            ts[numC] := chr(val mod 10 + ord('0'));
  218. X            val := val div 10;
  219. X          end;
  220. X        adjust(s, numC);
  221. X        for i := 1 to numC do
  222. X          s[i] := ts[numC - i + 1];
  223. X      end;
  224. X  end { dectos };
  225. X
  226. Xbegin { showCaptures }
  227. X  dectos(captures[black]);
  228. X  SSetCursor(captNBX, captNY);
  229. X  write(s:3);
  230. X  dectos(captures[white]);
  231. X  SSetCursor(captNWX, captNY);
  232. X  write(s:3);
  233. Xend { showCaptures };
  234. X
  235. Xprocedure turnIs(who: sType);
  236. Xbegin { turnIs }
  237. X  SSetCursor(turnX, turnY);
  238. X  if who = white then
  239. X    write('White to Play')
  240. X  else
  241. X    write('Black to Play');
  242. Xend { turnIs };
  243. X
  244. Xprocedure putBString(x, y: integer; s: string);
  245. Xvar
  246. X  xp, yp, sw, i: integer;
  247. X  fnt: fontPtr;
  248. Xbegin { putBString }
  249. X  setFont(goSNumFont);
  250. X  fnt := goSNumFont;
  251. X  for i := 1 to length(s) do
  252. X    if (s[i] >= '0') and
  253. X       (s[i] <= '9') then
  254. X      s[i] := chr(ord(s[i]) - #46 + #200);
  255. X  xp := x * gridWidth + xMargin;
  256. X  yp := y * gridWidth + yMargin;
  257. X  sw := 0;
  258. X  for i := 1 to length(s) do
  259. X    sw := sw + fnt^.index[lAnd(ord(s[i]), #177)].width;
  260. X  xp := xp - (sw div 2);
  261. X  yp := yp + (fnt^.height div 2) + 1;
  262. X  SChrFunc(0);
  263. X  SSetCursor(xp, yp);
  264. X  write(s:0);
  265. Xend { putBString };
  266. X
  267. Xprocedure putStone(cx, cy, mNum: integer; val: bVal);
  268. Xconst
  269. X  widthPad = 2;
  270. X  shPad = 3;
  271. X  bhPad = 1;
  272. Xvar
  273. X  x, y, org: integer;
  274. X  ns: string;
  275. X  sl, d, sw, n: integer;
  276. X  cv: integer;
  277. X  fnt: fontPtr;
  278. X  heightPad: integer;
  279. Xbegin { putStone }
  280. X  x := cx - sPicC;
  281. X  y := cy - sPicC;
  282. X  rasterop(RAndNot, sPicS, sPicS, x, y, SScreenW, SScreenP,
  283. X                                  0, 0, picWW, stones[black]);
  284. X  rasterop(ROr, sPicS, sPicS, x, y, SScreenW, SScreenP,
  285. X                              0, 0, picWW, stones[val]);
  286. X  if numbEnabled and (mNum > 0) then
  287. X    begin
  288. X      n := mNum - sNumBase;
  289. X      if n < 0 then
  290. X        exit(putStone);
  291. X      n := n + sNumStart;
  292. X      if bigNums then
  293. X        begin
  294. X          fnt := goBNumFont;
  295. X          heightPad := bhPad;
  296. X        end
  297. X      else
  298. X        begin
  299. X          fnt := goSNumFont;
  300. X          heightPad := shPad;
  301. X        end;
  302. X      if val = black then
  303. X        if bigNums then
  304. X          begin
  305. X            if n > 9 then
  306. X              org := ord('`')
  307. X            else
  308. X              org := ord('j');
  309. X          end
  310. X        else
  311. X          begin
  312. X            if n > 99 then
  313. X              org := #24
  314. X            else
  315. X              org := #0;
  316. X          end
  317. X      else if bigNums then
  318. X        begin
  319. X          if n > 9 then
  320. X            org := ord('@')
  321. X          else
  322. X            org := ord('J');
  323. X        end
  324. X      else
  325. X        begin
  326. X          if n > 99 then
  327. X            org := #12
  328. X          else
  329. X            org := #60;
  330. X        end;
  331. X      ns := '   ';
  332. X      sl := 0;
  333. X      sw := 0;
  334. X      if n >= 100 then
  335. X        d := 100
  336. X      else if n >= 10 then
  337. X        d := 10
  338. X      else
  339. X        d := 1;
  340. X      while d > 0 do
  341. X        begin
  342. X          sl := sl + 1;
  343. X          cv := (n div d) + org;
  344. X          ns[sl] := chr(cv + #200);
  345. X          sw := sw + fnt^.index[cv].width;
  346. X          n := n mod d;
  347. X          d := d div 10;
  348. X        end;
  349. X      adjust(ns, sl);
  350. X      x := cx - (sw div 2) + widthPad;
  351. X      y := cy + (fnt^.height div 2) + heightPad;
  352. X      setFont(fnt);
  353. X      SSetCursor(x, y);
  354. X      SChrFunc(6);
  355. X      write(ns);
  356. X      setFont(sysFont);
  357. X      SChrFunc(0);
  358. X    end;
  359. Xend { putStone };
  360. X
  361. Xprocedure showStone(lx, ly: integer);
  362. Xvar
  363. X  x, y: integer;
  364. Xbegin { showStone }
  365. X  with board[lx, ly] do
  366. X    begin
  367. X      if printing then
  368. X        if printLarge then
  369. X          begin
  370. X            x := lx * pGridWidth + pxMargin;
  371. X            y := ly * pGridWidth + pyMargin;
  372. X          end
  373. X        else { small board }
  374. X          begin
  375. X            x := lx * gridWidth + xMargin;
  376. X            y := ly * gridWidth + yMargin;
  377. X          end
  378. X      else { not printing }
  379. X        begin
  380. X          x := lx * gridWidth + xMargin + xOfs;
  381. X          y := ly * gridWidth + yMargin + yOfs;
  382. X        end;
  383. X      putStone(x, y, mNum, val);
  384. X    end;
  385. Xend { showStone };
  386. X
  387. Xprocedure showAllStones;
  388. Xvar
  389. X  i, j: integer;
  390. Xbegin { showAllStones }
  391. X  for j := 0 to maxPoint do
  392. X    for i := 0 to maxPoint do
  393. X      if board[i, j].val <> empty then
  394. X        showStone(i, j);
  395. Xend { showAllStones };
  396. X
  397. Xprocedure dotStone(lx, ly: integer);
  398. Xvar
  399. X  x, y: integer;
  400. Xbegin { dotStone }
  401. X  with board[lx, ly] do
  402. X    if val <> empty then
  403. X      begin
  404. X        x := lx * gridWidth + xMargin + xOfs;
  405. X        y := ly * gridWidth + yMargin + yOfs;
  406. X        rasterop(rNot, 2, 2, x, y, SScreenW, SScreenP,
  407. X                             x, y, SScreenW, SScreenP);
  408. X      end;
  409. Xend { dotStone };
  410. X
  411. Xfunction bLocCur(cx, cy: integer; var lx, ly, sx, sy: integer): boolean;
  412. Xvar
  413. X  xic, yic: integer;
  414. Xbegin { bLocCur }
  415. X  bLocCur := false;
  416. X  if printing and printLarge then
  417. X    begin
  418. X      cx := cx - pGridXMargin;
  419. X      cy := cy - pGridYMargin;
  420. X    end
  421. X  else
  422. X    begin
  423. X      cx := cx - gridXMargin;
  424. X      cy := cy - gridYMargin;
  425. X    end;
  426. X  if (cx >= 0) and (cy >= 0) then
  427. X    begin
  428. X      if printing and printLarge then
  429. X        begin
  430. X          lx := cx div pGridWidth;
  431. X          ly := cy div pGridWidth;
  432. X          xic := lx * pGridWidth + pGridBorder;
  433. X          yic := ly * pGridWidth + pGridBorder;
  434. X        end
  435. X      else
  436. X        begin
  437. X          lx := cx div gridWidth;
  438. X          ly := cy div gridWidth;
  439. X          xic := lx * gridWidth + gridBorder;
  440. X          yic := ly * gridWidth + gridBorder;
  441. X        end;
  442. X      if (lx <= maxPoint) and (ly <= maxPoint) then
  443. X        begin
  444. X          if cx < xic - slopSize then
  445. X            cx := xic - slopSize
  446. X          else if cx > xic + slopSize then
  447. X            cx := xic + slopSize;
  448. X          if cy < yic - slopSize then
  449. X            cy := yic - slopSize
  450. X          else if cy > yic + slopSize then
  451. X            cy := yic + slopSize;
  452. X          sx := cx - xic;
  453. X          sy := cy - yic;
  454. X          bLocCur := true;
  455. X        end;
  456. X     end;
  457. Xend { bLocCur };
  458. X
  459. Xprocedure showPass(which: sType);
  460. Xbegin { showPass }
  461. X  SSetCursor(passX, passY);
  462. X  if which = black then
  463. X    write(' Black Passes ')
  464. X  else
  465. X    write(' White Passes ');
  466. X  passShowing := true;
  467. Xend { showPass };
  468. X
  469. Xprocedure remPass;
  470. Xbegin { remPass }
  471. X  SSetCursor(passX, passY);
  472. X  write('               ');
  473. X  passShowing := false;
  474. Xend { remPass };
  475. X
  476. Xfunction passLocCur(cx, cy: integer): boolean;
  477. Xbegin { passLocCur }
  478. X  passLocCur :=  (cx >= passX) and (cx < (passX + passW)) and
  479. X                 (cy <= passY) and (cy > (passY - passH));
  480. Xend { passLocCur };
  481. X
  482. Xprocedure showAlt(lx, ly: integer; sv: sType);
  483. Xbegin { showAlt }
  484. X  with board[lx, ly] do
  485. X    begin
  486. X      lx := lx * gridWidth + xMargin - sPicC;
  487. X      ly := ly * gridWidth + yMargin - sPicC;
  488. X      rasterop(ROr, sPicS, sPicS, lx, ly, SScreenW, SScreenP,
  489. X                                  0, 0, picWW, stoneCir);
  490. X    end;
  491. Xend { showAlt };
  492. X
  493. Xprocedure placeStone(which: sType; lx, ly, ofx, ofy, moveNum: integer);
  494. Xbegin { placeStone }
  495. X  if passShowing then
  496. X    remPass;
  497. X  with board[lx, ly] do
  498. X    begin
  499. X      val := which;
  500. X      xOfs := ofx;
  501. X      yOfs := ofy;
  502. X      mNum := moveNum;
  503. X      showStone(lx, ly);
  504. X    end;
  505. Xend { placeStone };
  506. X
  507. Xprocedure placeAlt(which: sType; lx, ly, ofx, ofy: integer);
  508. Xbegin { placeAlt }
  509. X  with board[lx, ly] do
  510. X    begin
  511. X      val := alternate;
  512. X      xOfs := 0;
  513. X      yOfs := 0;
  514. X      mNum := -1;
  515. X      showAlt(lx, ly, which);
  516. X    end;
  517. Xend { placeAlt };
  518. X
  519. Xprocedure remStone(lx, ly: integer);
  520. Xvar
  521. X  x, y, i, j: integer;
  522. Xbegin { remStone }
  523. X  with board[lx, ly] do
  524. X    if val <> empty then
  525. X      begin
  526. X        val := empty;
  527. X        if ly = 0 then
  528. X          i := 1
  529. X        else if ly = maxPoint then
  530. X          i := 7
  531. X        else i := 4;
  532. X        if lx = maxPoint then
  533. X          i := i + 2
  534. X        else if lx > 0 then
  535. X          i := i + 1; 
  536. X        if printing and printLarge then
  537. X          begin
  538. X            x := (lx * pGridWidth) - patchC + pxMargin;
  539. X            y := (ly * pGridWidth) - patchC + pyMargin;
  540. X          end
  541. X        else
  542. X          begin
  543. X            x := (lx * gridWidth) - patchC + xMargin;
  544. X            y := (ly * gridWidth) - patchC + yMargin;
  545. X          end;
  546. X        rasterop(RRpl, patchS, patchS, x, y, SScreenW, SScreenP,
  547. X                                       0, 0, picWW, patch[i]);
  548. X        if ((lx = 3)  and (ly = 3))  or
  549. X           ((lx = 9)  and (ly = 3))  or
  550. X           ((lx = 15) and (ly = 3))  or
  551. X           ((lx = 3)  and (ly = 9))  or
  552. X           ((lx = 9)  and (ly = 9))  or
  553. X           ((lx = 15) and (ly = 9))  or
  554. X           ((lx = 3)  and (ly = 15)) or
  555. X           ((lx = 9)  and (ly = 15)) or
  556. X           ((lx = 15) and (ly = 15)) then
  557. X          if printing and printLarge then
  558. X            rasterop(ROr, hpPicS, hpPicS,
  559. X                     pxMargin + (pGridWidth * lx) - hpPicC,
  560. X                     pyMargin + (pGridWidth * ly) - hpPicC,
  561. X                     SScreenW, SScreenP,
  562. X                     0, 0, picWW, hcDot)
  563. X          else
  564. X            rasterop(ROr, hpPicS, hpPicS,
  565. X                     xMargin + (gridWidth * lx) - hpPicC,
  566. X                     yMargin + (gridWidth * ly) - hpPicC,
  567. X                     SScreenW, SScreenP,
  568. X                     0, 0, picWW, hcDot);
  569. X        for i := lx - 1 to lx + 1 do
  570. X          for j := ly - 1 to ly + 1 do
  571. X            if (i >= 0) and (i <= maxPoint) and
  572. X               (j >= 0) and (j <= maxPoint) then
  573. X              if (board[i, j].val = black) or
  574. X                 (board[i, j].val = white) then
  575. X                begin
  576. X                  showStone(i, j);
  577. X                  if (i = dotSX) and (j = dotSY) then
  578. X                    dotStone(i, j);
  579. X                end; 
  580. X      end;
  581. Xend { remStone };
  582. X
  583. Xprocedure addHCStones(num: integer);
  584. Xbegin { addHCStones }
  585. X  case num of
  586. X    2: 
  587. X      begin
  588. X        placeStone(black, 3, 15, 0, 0, 0);
  589. X        placeStone(black, 15, 3, 0, 0, 0);
  590. X      end;
  591. X    3:
  592. X      begin
  593. X        placeStone(black, 3, 15, 0, 0, 0);
  594. X        placeStone(black, 15, 3, 0, 0, 0);
  595. X        placeStone(black, 15, 15, 0, 0, 0);
  596. X      end;
  597. X    4:
  598. X      begin
  599. X        placeStone(black, 3, 15, 0, 0, 0);
  600. X        placeStone(black, 15, 3, 0, 0, 0);
  601. X        placeStone(black, 3, 3, 0, 0, 0);
  602. X        placeStone(black, 15, 15, 0, 0, 0);
  603. X      end;
  604. X    5:
  605. X      begin
  606. X        placeStone(black, 3, 3, 0, 0, 0);
  607. X        placeStone(black, 3, 15, 0, 0, 0);
  608. X        placeStone(black, 9, 9, 0, 0, 0);
  609. X        placeStone(black, 15, 3, 0, 0, 0);
  610. X        placeStone(black, 15, 15, 0, 0, 0);
  611. X      end;
  612. X    6:
  613. X      begin
  614. X        placeStone(black, 3, 3, 0, 0, 0);
  615. X        placeStone(black, 3, 15, 0, 0, 0);
  616. X        placeStone(black, 3, 9, 0, 0, 0);
  617. X        placeStone(black, 15, 9, 0, 0, 0);
  618. X        placeStone(black, 15, 3, 0, 0, 0);
  619. X        placeStone(black, 15, 15, 0, 0, 0);
  620. X      end;
  621. X    7:
  622. X      begin
  623. X        placeStone(black, 3, 3, 0, 0, 0);
  624. X        placeStone(black, 3, 15, 0, 0, 0);
  625. X        placeStone(black, 3, 9, 0, 0, 0);
  626. X        placeStone(black, 9, 9, 0, 0, 0);
  627. X        placeStone(black, 15, 9, 0, 0, 0);
  628. X        placeStone(black, 15, 3, 0, 0, 0);
  629. X        placeStone(black, 15, 15, 0, 0, 0);
  630. X      end;
  631. X    8:
  632. X      begin
  633. X        placeStone(black, 3, 3, 0, 0, 0);
  634. X        placeStone(black, 3, 9, 0, 0, 0);
  635. X        placeStone(black, 3, 15, 0, 0, 0);
  636. X        placeStone(black, 9, 3, 0, 0, 0);
  637. X        placeStone(black, 9, 15, 0, 0, 0);
  638. X        placeStone(black, 15, 3, 0, 0, 0);
  639. X        placeStone(black, 15, 9, 0, 0, 0);
  640. X        placeStone(black, 15, 15, 0, 0, 0);
  641. X      end;
  642. X    9:
  643. X      begin
  644. X        placeStone(black, 3, 3, 0, 0, 0);
  645. X        placeStone(black, 3, 9, 0, 0, 0);
  646. X        placeStone(black, 3, 15, 0, 0, 0);
  647. X        placeStone(black, 9, 3, 0, 0, 0);
  648. X        placeStone(black, 9, 9, 0, 0, 0);
  649. X        placeStone(black, 9, 15, 0, 0, 0);
  650. X        placeStone(black, 15, 3, 0, 0, 0);
  651. X        placeStone(black, 15, 9, 0, 0, 0);
  652. X        placeStone(black, 15, 15, 0, 0, 0);
  653. X      end;
  654. X    end;
  655. Xend { addHCStones };
  656. X
  657. Xprocedure drawBoard;
  658. Xvar
  659. X  i, j, c, lWidth, x, y, w: integer;
  660. X  xMarg, yMarg, gWid, eBX, eBY, eLX, eLY: integer;
  661. Xbegin { drawBoard }
  662. X  if printing then
  663. X    begin
  664. X      lWidth := 1;
  665. X      if printLarge then
  666. X        begin
  667. X          xMarg := pxMargin;
  668. X          yMarg := pyMargin;
  669. X          gWid := pGridWidth;
  670. X          eBX := pedgeBX;
  671. X          eBY := pedgeBY;
  672. X          eLX := pedgeLX;
  673. X          eLY := pedgeLY;
  674. X        end
  675. X      else
  676. X        begin
  677. X          xMarg := xMargin;
  678. X          yMarg := yMargin;
  679. X          gWid := gridWidth;
  680. X          eBX := edgeBX;
  681. X          eBY := edgeBY;
  682. X          eLX := edgeLX;
  683. X          eLY := edgeLY;
  684. X        end
  685. X    end
  686. X  else
  687. X    begin
  688. X      lWidth := lineWidth;
  689. X      xMarg := xMargin;
  690. X      yMarg := yMargin;
  691. X      gWid := gridWidth;
  692. X    end;
  693. X  if not printing then
  694. X    for i := (htYMargin div htHeight) to 
  695. X             ((htYMargin + boardHeight) div htHeight) - 1 do
  696. X      rasterop(RRpl, bWinW - (htXMargin * 2), htHeight,
  697. X                     htXMargin, i * htHeight, SScreenW, SScreenP,
  698. X                     htXMargin, 0, htWidth, htBuf)
  699. X  else
  700. X    rasterop(rAndNot, bWinW - (phtXMargin * 2), (bWinY + bWinH) - phtYMargin,
  701. X                      phtXMargin, phtYMargin, SScreenW, SScreenP,
  702. X                      phtXMargin, phtYMargin, SScreenW, SScreenP);
  703. X  for i := 1 to maxPoint - 1 do
  704. X    rasterop(ROrNot, (maxPoint * gWid) + lWidth, lWidth,
  705. X                     xMarg, yMarg + (i * gWid), SScreenW, SScreenP,
  706. X                     xMarg, yMarg + (i * gWid), SScreenW, SScreenP);
  707. X  for i := 1 to maxPoint - 1 do
  708. X    rasterop(ROrNot, lWidth, (maxPoint * gWid) + lWidth,
  709. X                     xMarg + (i * gWid), yMarg, SScreenW, SScreenP,
  710. X                     xMarg + (i * gWid), yMarg, SScreenW, SScreenP);
  711. X  rasterop(ROrNot, (maxPoint * gWid) + lineWidth, lineWidth,
  712. X                   xMarg, yMarg, SScreenW, SScreenP,
  713. X                   xMarg, yMarg, SScreenW, SScreenP);
  714. X  rasterop(ROrNot, (maxPoint * gWid) + lineWidth, lineWidth,
  715. X                xMarg, yMarg + (maxPoint * gWid), SScreenW, SScreenP,
  716. X                xMarg, yMarg + (maxPoint * gWid), SScreenW, SScreenP);
  717. X  rasterop(ROrNot, lineWidth, (maxPoint * gWid) + lineWidth,
  718. X                   xMarg, yMarg, SScreenW, SScreenP,
  719. X                   xMarg, yMarg, SScreenW, SScreenP);
  720. X  rasterop(ROrNot, lineWidth, (maxPoint * gWid) + lineWidth,
  721. X                xMarg + (maxPoint * gWid), yMarg, SScreenW, SScreenP,
  722. X                xMarg + (maxPoint * gWid), yMarg, SScreenW, SScreenP);
  723. X  rasterop(ROr, hpPicS, hpPicS,
  724. X                xMarg + (gWid * 3) - hpPicC,
  725. X                yMarg + (gWid * 3) - hpPicC,
  726. X                SScreenW, SScreenP,
  727. X                0, 0, picWW, hcDot);
  728. X  rasterop(ROr, hpPicS, hpPicS,
  729. X                xMarg + (gWid * 9) - hpPicC,
  730. X                yMarg + (gWid * 3) - hpPicC,
  731. X                SScreenW, SScreenP,
  732. X                0, 0, picWW, hcDot);
  733. X  rasterop(ROr, hpPicS, hpPicS,
  734. X                xMarg + (gWid * 15) - hpPicC,
  735. X                yMarg + (gWid * 3) - hpPicC,
  736. X                SScreenW, SScreenP,
  737. X                0, 0, picWW, hcDot);
  738. X  rasterop(ROr, hpPicS, hpPicS,
  739. X                xMarg + (gWid * 3) - hpPicC,
  740. X                yMarg + (gWid * 9) - hpPicC,
  741. X                SScreenW, SScreenP,
  742. X                0, 0, picWW, hcDot);
  743. X  rasterop(ROr, hpPicS, hpPicS,
  744. X                xMarg + (gWid * 9) - hpPicC,
  745. X                yMarg + (gWid * 9) - hpPicC,
  746. X                SScreenW, SScreenP,
  747. X                0, 0, picWW, hcDot);
  748. X  rasterop(ROr, hpPicS, hpPicS,
  749. X                xMarg + (gWid * 15) - hpPicC,
  750. X                yMarg + (gWid * 9) - hpPicC,
  751. X                SScreenW, SScreenP,
  752. X                0, 0, picWW, hcDot);
  753. X  rasterop(ROr, hpPicS, hpPicS,
  754. X                xMarg + (gWid * 3) - hpPicC,
  755. X                yMarg + (gWid * 15) - hpPicC,
  756. X                SScreenW, SScreenP,
  757. X                0, 0, picWW, hcDot);
  758. X  rasterop(ROr, hpPicS, hpPicS,
  759. X                xMarg + (gWid * 9) - hpPicC,
  760. X                yMarg + (gWid * 15) - hpPicC,
  761. X                SScreenW, SScreenP,
  762. X                0, 0, picWW, hcDot);
  763. X  rasterop(ROr, hpPicS, hpPicS,
  764. X                xMarg + (gWid * 15) - hpPicC,
  765. X                yMarg + (gWid * 15) - hpPicC,
  766. X                SScreenW, SScreenP,
  767. X                0, 0, picWW, hcDot);
  768. X  if not printing then
  769. X    begin
  770. X      SSetCursor(captBX, captY);
  771. X      write('Black Captures');
  772. X      SSetCursor(captWX, captY);
  773. X      write('White Captures');
  774. X    end
  775. X  else
  776. X    begin
  777. X      for i := 1 to maxPoint + 1 do
  778. X        begin
  779. X          if i > 9 then
  780. X            w := charWidth * 2
  781. X          else 
  782. X            w := charWidth;
  783. X          x := ((i - 1) * gWid) + eBX - (w div 2);
  784. X          y := eBY + charHeight;
  785. X          SSetCursor(x, y);
  786. X          write(i:0);
  787. X        end;
  788. X      for i := 0 to maxPoint do
  789. X        begin
  790. X          x := eLX - charWidth;
  791. X          y := eLY - ((maxPoint - i) * gWid) + (charHeight div 2);
  792. X          c := i + ord('A');
  793. X          if c >= ord('I') then
  794. X            c := c + 1;
  795. X          SSetCursor(x, y);
  796. X          SPutChr(chr(c));
  797. X        end;
  798. X    end;
  799. Xend { drawBoard };
  800. X
  801. Xprocedure clearBoard;
  802. Xvar
  803. X  i, j, xMarg, yMarg, gWid: integer;
  804. Xbegin { clearBoard }
  805. X  drawBoard;
  806. X  if printing and printLarge then
  807. X    begin
  808. X      xMarg := pxMargin;
  809. X      yMarg := pyMargin;
  810. X      gWid := pGridWidth;
  811. X    end
  812. X  else
  813. X    begin
  814. X      xMarg := xMargin;
  815. X      yMarg := yMargin;
  816. X      gWid := gridWidth;
  817. X    end;
  818. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[1],
  819. X                                 xMarg + (0 * gWid) - patchC,
  820. X                                 yMarg + (0 * gWid) - patchC,
  821. X                                 SScreenW, SScreenP);
  822. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[2],
  823. X                                 xMarg + (6 * gWid) - patchC,
  824. X                                 yMarg + (0 * gWid) - patchC,
  825. X                                 SScreenW, SScreenP);
  826. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[3],
  827. X                                 xMarg + (18 * gWid) - patchC,
  828. X                                 yMarg + (0 * gWid) - patchC,
  829. X                                 SScreenW, SScreenP);
  830. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[4],
  831. X                                 xMarg + (0 * gWid) - patchC,
  832. X                                 yMarg + (6 * gWid) - patchC,
  833. X                                 SScreenW, SScreenP);
  834. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[5],
  835. X                                 xMarg + (6 * gWid) - patchC,
  836. X                                 yMarg + (6 * gWid) - patchC,
  837. X                                 SScreenW, SScreenP);
  838. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[6],
  839. X                                 xMarg + (18 * gWid) - patchC,
  840. X                                 yMarg + (6 * gWid) - patchC,
  841. X                                 SScreenW, SScreenP);
  842. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[7],
  843. X                                 xMarg + (0 * gWid) - patchC,
  844. X                                 yMarg + (18 * gWid) - patchC,
  845. X                                 SScreenW, SScreenP);
  846. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[8],
  847. X                                 xMarg + (6 * gWid) - patchC,
  848. X                                 yMarg + (18 * gWid) - patchC,
  849. X                                 SScreenW, SScreenP);
  850. X  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[9],
  851. X                                 xMarg + (18 * gWid) - patchC,
  852. X                                 yMarg + (18 * gWid) - patchC,
  853. X                                 SScreenW, SScreenP);
  854. X  for i := 0 to maxPoint do
  855. X    for j := 0 to maxPoint do
  856. X      board[i][j].val := empty;
  857. X  if not printing then
  858. X    remPass;
  859. Xend { clearBoard };
  860. X
  861. Xprocedure showPlayHistory(isDiagram: boolean);
  862. Xvar
  863. X  curRow, curCol, bx, by, bLim, curNum: integer;
  864. X  cm, scm, tm: pMRec;
  865. X  c: char;
  866. X  needWipe, lastCapt: boolean;
  867. X
  868. X  procedure getMarks;
  869. X  var
  870. X    bx, by, lbx, lby, gx, gy, sMark, x, y, w: integer;
  871. X    curC: char;
  872. X    done: boolean;
  873. X  begin { getMarks }
  874. X    lbx := -1;
  875. X    lby := -1;
  876. X    curC := 'a';
  877. X    sMark := 0;
  878. X    prompt('Point at locations to place marks - press off board to stop');
  879. X    while tabSwitch do;
  880. X    done := false;
  881. X    setFont(goSLetFont);
  882. X    sChrFunc(rOr);
  883. X    repeat
  884. X      while not tabSwitch do;
  885. X      if bLocCur(tabRelX, tabRelY, bx, by, gx, gy) then
  886. X        begin
  887. X          if printLarge then
  888. X            begin
  889. X              x := bx * pGridWidth + pxMargin;
  890. X              y := by * pGridWidth + pyMargin;
  891. X            end
  892. X          else
  893. X            begin
  894. X              x := bx * GridWidth + xMargin;
  895. X              y := by * GridWidth + yMargin;
  896. X            end;
  897. X          if board[bx, by].val = empty then
  898. X            begin
  899. X              rasterop(rXor, 20, 30, x - 10, y - 15, SScreenW, SScreenP,
  900. X                                     x - 10, y - 15, SScreenW, SScreenP);
  901. X              w := goSLetFont^.index[ord(curC)].width - 2;
  902. X              SSetCursor(x - (w div 2), y + 7);
  903. X              write(curC);
  904. X              curC := chr(ord(curC) + 1);
  905. X            end
  906. X          else
  907. X            begin
  908. X              x := x - sPicC;
  909. X              y := y - sPicC;
  910. X              if (bx = lbx) and (by = lby) then
  911. X                begin
  912. X                  if sMark <= maxSMark then
  913. X                    begin
  914. X                      rasterop(RXor, sPicS, sPicS, x, y, SScreenW, SScreenP,
  915. X                                             0, 0, picWW, stoneMarks[sMark]);
  916. X                      sMark := sMark + 1;
  917. X                    end
  918. X                  else
  919. X                    sMark := 0;
  920. X                end
  921. X              else
  922. X                sMark := 0;
  923. X              if sMark <= maxSMark then
  924. X                rasterop(RXor, sPicS, sPicS, x, y, SScreenW, SScreenP,
  925. X                                             0, 0, picWW, stoneMarks[sMark]);
  926. X            end;
  927. X          lbx := bx;
  928. X          lby := by;
  929. X        end
  930. X      else
  931. X        done := true;
  932. X      while tabSwitch do;
  933. X    until done;
  934. X    sChrFunc(rRpl);
  935. X    setFont(sysFont);
  936. X    prompt('');
  937. X  end { getMarks };
  938. X
  939. Xbegin { showPlayHistory }
  940. X  if not isDiagram then
  941. X    begin
  942. X      bLim := 99;
  943. X      sNumBase := 0;
  944. X      sNumStart := 0;
  945. X    end
  946. X  else
  947. X    bLim := 1000;
  948. X  curNum := 0;
  949. X  needWipe := true;
  950. X  wipeTreeMarks;
  951. X  cm := curMove;
  952. X  while cm <> treeRoot do
  953. X    begin
  954. X      cm^.mark := true;
  955. X      cm := cm^.blink;
  956. X    end;
  957. X  repeat
  958. X    if needWipe then
  959. X      begin
  960. X        rasterop(rAndNot, 768, 1024 - extraYO,
  961. X                 0, extraYO, SScreenW, SScreenP,
  962. X                 0, extraYO, SScreenW, SScreenP);
  963. X        curRow := 0;
  964. X        curCol := 0;
  965. X        showAllStones;
  966. X        needWipe := false;
  967. X      end;
  968. X    cm := cm^.flink;
  969. X    while not cm^.mark do
  970. X      cm := cm^.slink;
  971. X    with cm^ do
  972. X      case id of
  973. X        hcPlay:
  974. X          begin
  975. X            addHCStones(hcNum);
  976. X            curNum := 1;
  977. X          end;
  978. X        move:
  979. X          begin
  980. X            if board[mx, my].val <> empty then
  981. X              begin
  982. X                bx := curCol * (20 * charWidth) + extraXO;
  983. X                by := curRow * charHeight * 2 + extraYO + charHeight;
  984. X                SSetCursor(bx, by);
  985. X                if who = black then
  986. X                  write('Black ')
  987. X                else
  988. X                  write('White ');
  989. X                write((moveN - sNumBase):0, ' at ');
  990. X                c := chr(my + ord('A'));
  991. X                if c >= 'I' then
  992. X                  c := chr(ord(c) + 1);
  993. X                write(c, '-', (mx + 1):0);
  994. X                curRow := curRow + 1;
  995. X                if (curRow * charHeight * 2 + extraYO + charHeight) > 1000 then
  996. X                  begin
  997. X                    curRow := 0;
  998. X                    curCol := curCol + 1;
  999. X                  end;
  1000. X              end
  1001. X            else
  1002. X              placeStone(who, mx, my, 0, 0, moveN);
  1003. X            curNum := moveN;
  1004. X            lastCapt := false;
  1005. X            repeat
  1006. X              if cm^.flink = nil then
  1007. X                lastCapt := true
  1008. X              else if cm^.flink^.id = remove then
  1009. X                begin
  1010. X                  cm := cm^.flink;
  1011. X                  if curNum < sNumBase then
  1012. X                    remStone(cm^.mx, cm^.my);
  1013. X                end
  1014. X              else
  1015. X                lastCapt := true;
  1016. X            until lastCapt;
  1017. X          end;
  1018. X        pass:
  1019. X          begin
  1020. X            if not isDiagram then
  1021. X              begin
  1022. X                bx := curCol * (20 * charWidth) + extraXO;
  1023. X                by := curRow * charHeight * 2 + extraYO + charHeight;
  1024. X                SSetCursor(bx, by);
  1025. X                if who = black then
  1026. X                  write('Black ')
  1027. X                else
  1028. X                  write('White ');
  1029. X                write((moveN - sNumBase):0, ' - Pass');
  1030. X                curRow := curRow + 1;
  1031. X                if (curRow * charHeight * 2 + extraYO + charHeight) > 1000 then
  1032. X                  begin
  1033. X                    curRow := 0;
  1034. X                    curCol := curCol + 1;
  1035. X                  end;
  1036. X              end;
  1037. X            curNum := moveN;
  1038. X          end;
  1039. X      end { case };
  1040. X    if (curNum = bLim) or
  1041. X       (cm = curMove) then
  1042. X      begin
  1043. X        if isDiagram then
  1044. X          getMarks;
  1045. X        csdx;
  1046. X        if cm <> curMove then
  1047. X          begin
  1048. X            sNumBase := bLim + 1;
  1049. X            bLim := bLim + 100;
  1050. X            needWipe := true;
  1051. X            clearBoard;
  1052. X            scm := curMove;
  1053. X            curMove := treeRoot;
  1054. X            switchBranch(cm);
  1055. X            curMove := scm;
  1056. X            wipeTreeMarks;
  1057. X            tm := curMove;
  1058. X            while tm <> treeRoot do
  1059. X              begin
  1060. X               tm^.mark := true;
  1061. X               tm := tm^.blink;
  1062. X              end;
  1063. X          end;
  1064. X      end;               
  1065. X  until cm = curMove;
  1066. X  sNumBase := 0;
  1067. X  sNumStart := 0;
  1068. Xend { showPlayHistory };
  1069. X
  1070. Xprocedure printBoard(isDiagram: boolean);
  1071. Xlabel
  1072. X  1;
  1073. Xvar
  1074. X  sseg: integer;
  1075. X  neWas: boolean;
  1076. X  cmSave: pMRec;
  1077. X
  1078. X  procedure showFName;
  1079. X  var
  1080. X    fnX, fnY: integer;
  1081. X    fs: string;
  1082. X  begin { showFName }
  1083. X    getFNameString(fs);
  1084. X    if fs <> '' then
  1085. X      begin
  1086. X        fnY := charHeight + 8;
  1087. X        fnX := 384 - (charWidth * length(fs) div 2);
  1088. X        SSetCursor(fnX, fnY);
  1089. X        write(fs);
  1090. X      end;
  1091. X  end { showFName };
  1092. X
  1093. X  procedure showComments(isDiagram: boolean);
  1094. X  var
  1095. X    cx: integer;
  1096. X    cs: string;
  1097. X  begin { showComments }
  1098. X    if not isDiagram then
  1099. X      if getComment(treeRoot, cs) then
  1100. X        begin
  1101. X          cx := 384 - (charWidth * length(cs) div 2);
  1102. X          SSetCursor(cx, rCmtY);
  1103. X          write(cs);
  1104. X        end;
  1105. X    if getComment(curMove, cs) then
  1106. X      begin
  1107. X        cx := 384 - (charWidth * length(cs) div 2);
  1108. X        if isDiagram then
  1109. X          SSetCursor(cx, charHeight + 8)
  1110. X        else
  1111. X          SSetCursor(cx, lCmtY);
  1112. X        write(cs);
  1113. X      end;
  1114. X  end { showComments };
  1115. X
  1116. X  handler ctlC;
  1117. X  begin { ctlC }
  1118. X    IOKeyClear;
  1119. X    resetInput;
  1120. X    write(''); {control-G}
  1121. X    prompt('');
  1122. X    goto 1;
  1123. X  end { ctlC };
  1124. X
  1125. X  function readNum(pmpt: string): integer;
  1126. X  label
  1127. X    2;
  1128. X  var
  1129. X    n: integer;
  1130. X
  1131. X    handler notNumber(fn: pathName);
  1132. X    begin { notNumber }
  1133. X      write(''); {control-G}
  1134. X      prompt('Bad Number - try again: ');
  1135. X      goto 2;
  1136. X    end { notNumber };
  1137. X
  1138. X    handler pastEOF(fn: pathName);
  1139. X    begin { pastEOF }
  1140. X      write(''); {control-G}
  1141. X      goto 1;
  1142. X    end { pastEOF };
  1143. X
  1144. X  begin { readNum }
  1145. X    prompt('');
  1146. X  2:
  1147. X    resetInput;
  1148. X    write(pmpt);
  1149. X    readln(n);
  1150. X    readNum := n;
  1151. X  end { readNum };
  1152. X
  1153. Xbegin { printBoard }
  1154. X  if curMove = treeRoot then
  1155. X    begin
  1156. X      write(''); {control-G}
  1157. X      exit(printBoard);
  1158. X    end;
  1159. X  cmSave := curMove;
  1160. X  if scrSavPtr = nil then
  1161. X    begin
  1162. X      createSegment(sseg, 192, 1, 192);
  1163. X      scrSavPtr := makePtr(sseg, 0, rasterPtr);
  1164. X    end;
  1165. X  rasterop(rRpl, 768, 1024, 0, 0, SScreenW, scrSavPtr,
  1166. X                            0, 0, SScreenW, SScreenP);
  1167. X  rasterop(rAndNot, 768, 1024, 0, 0, SScreenW, SScreenP,
  1168. X                               0, 0, SScreenW, SScreenP);
  1169. X  printing := true;
  1170. X  neWas := numbEnabled;
  1171. X  numbEnabled := true;
  1172. X  sNumBase := 0;
  1173. X  sNumStart := 0;
  1174. X  drawBoard;
  1175. X  bigNums := false;
  1176. X  showAllStones;
  1177. X  if not isDiagram then
  1178. X    begin
  1179. X      showComments(false);
  1180. X      showFName;
  1181. X      csdx;
  1182. X    end
  1183. X  else
  1184. X    begin
  1185. X      sNumBase := readNum('Start Numbering at which stone? ');
  1186. X      sNumStart := readNum('First Number is? ');
  1187. X      prompt('');
  1188. X    end;
  1189. X  clearBoard;
  1190. X  bigNums := true;
  1191. X  if isDiagram then
  1192. X    showComments(true);
  1193. X  showPlayHistory(isDiagram);
  1194. X1:
  1195. X  rasterop(rRpl, 768, 1024, 0, 0, SScreenW, SScreenP,
  1196. X                            0, 0, SScreenW, scrSavPtr);
  1197. X  printing := false;
  1198. X  numbEnabled := neWas;
  1199. X  bigNums := false;
  1200. X  sNumBase := 0;
  1201. X  sNumStart := 0;
  1202. X  clearBoard;
  1203. X  curMove := treeRoot;
  1204. X  captures[black] := 0;
  1205. X  captures[white] := 0;
  1206. X  switchBranch(cmSave);
  1207. X  curMove := cmSave;
  1208. Xend { printBoard };
  1209. X
  1210. Xprocedure refreshBoard;
  1211. Xbegin { refreshBoard }
  1212. X  drawBoard;
  1213. X  showAllStones;
  1214. X  dotSX := -1;
  1215. X  dotLast;
  1216. Xend { refreshBoard };
  1217. X
  1218. X{ initializes this module }
  1219. Xprocedure initGoBoard;
  1220. X
  1221. X  procedure beepInit;
  1222. X  const
  1223. X    size = (WordSize(beepBuf) * 7 + 255) div 256;
  1224. X  var
  1225. X    d: SoundType;
  1226. X    i,j: integer;
  1227. X    beepSeg: integer;
  1228. X  begin { beepInit }
  1229. X    createSegment(beepSeg, size, 1, size);
  1230. X    new(0,4,StatPtr);
  1231. X    for d := atari to die3 do
  1232. X      new(beepSeg, 4, sounds[d]);
  1233. X    for i := 0 to 63 do
  1234. X      begin
  1235. X        sounds[atari]^[i] := 511;
  1236. X        case i mod 3 of
  1237. X          0: sounds[koV]^[i] := -5;
  1238. X          1: sounds[koV]^[i] := 34;
  1239. X          2: sounds[koV]^[i] := 0;
  1240. X        end;
  1241. X        case i mod 4 of
  1242. X          0: sounds[s3]^[i] := 1023;
  1243. X          1: sounds[s3]^[i] := 0;
  1244. X          2: sounds[s3]^[i] := -1;
  1245. X          3: sounds[s3]^[i] := -1023;
  1246. X        end;
  1247. X       case i mod 5 of
  1248. X          0: sounds[s4]^[i] := 43;
  1249. X          1: sounds[s4]^[i] := 765;
  1250. X          2: sounds[s4]^[i] := -432;
  1251. X          3: sounds[s4]^[i] := -6;
  1252. X          4: sounds[s4]^[i] := 345;
  1253. X       end;
  1254. X     end;
  1255. X   for i := 0 to 1 do
  1256. X     for j := 0 to 15 do
  1257. X       begin
  1258. X         sounds[die]^[i*32+j] := -1;
  1259. X         sounds[die]^[i*32+16+j] := 0;
  1260. X       end;
  1261. X   for i := 0 to 63 do
  1262. X     begin
  1263. X       sounds[die2]^[i] := sounds[die]^[i];
  1264. X       sounds[die3]^[i] := sounds[die]^[i];
  1265. X     end;
  1266. X  end { beepInit };
  1267. X
  1268. X  procedure definePats;
  1269. X  var
  1270. X    i, j, blks, gbg: integer;
  1271. X    fid: fileID;
  1272. X  begin { definePats }
  1273. X    fid := FSLookup('go.animate', blks, gbg);
  1274. X    if fid = 0 then
  1275. X      begin
  1276. X        writeln('GO.ANIMATE not found');
  1277. X        raise gbFatal;
  1278. X      end
  1279. X    else if blks < 8 then
  1280. X      begin
  1281. X        writeln('GO.ANIMATE too short');
  1282. X        raise gbFatal;
  1283. X      end;
  1284. X    new(0, 4, stones[black]);
  1285. X    FSBlkRead(fid, 0, recast(stones[black], pDirBlk));
  1286. X    new(0, 4, stones[white]);
  1287. X    FSBlkRead(fid, 1, recast(stones[white], pDirBlk));
  1288. X    new(0, 4, hcDot);
  1289. X    FSBlkRead(fid, 2, recast(hcDot, pDirBlk));
  1290. X    new(0, 4, selCursor);
  1291. X    FSBlkRead(fid, 3, recast(selCursor, pDirBlk));
  1292. X    new(0, 4, stoneCir);
  1293. X    FSBlkRead(fid, 4, recast(stoneCir, pDirBlk));
  1294. X    new(0, 4, stoneMarks[0]);
  1295. X    FSBlkRead(fid, 5, recast(stoneMarks[0], pDirBlk));
  1296. X    new(0, 4, stoneMarks[1]);
  1297. X    FSBlkRead(fid, 6, recast(stoneMarks[1], pDirBlk));
  1298. X    new(0, 4, stoneMarks[2]);
  1299. X    FSBlkRead(fid, 7, recast(stoneMarks[2], pDirBlk));
  1300. X    new(0, 4, htBuf);
  1301. X    for i := 0 to 47 do
  1302. X      htBuf^[0, i] := #125252;
  1303. X    for i := 0 to 47 do
  1304. X      htBuf^[1, i] := 0;
  1305. X    for i := 0 to 47 do
  1306. X      htBuf^[2, i] := #125252;   { #52525 }
  1307. X    for i := 0 to 47 do
  1308. X      htBuf^[3, i] := 0;
  1309. X    for i := 1 to 9 do
  1310. X      new(0, 4, patch[i]);
  1311. X  end { definePats };
  1312. X
  1313. X  procedure setupFont;
  1314. X  var
  1315. X    bblks, sblks, tBlks, lBlks, bits, fontseg, i: integer;
  1316. X    bFID, sFID, tFID, lFID: fileID;
  1317. X    bp: pDirBlk;
  1318. X  begin { setupFont }
  1319. X    sysFont := getFont;
  1320. X    bFID := FSLookup('goBNum.kst', bblks, bits);
  1321. X    if bFID = 0 then
  1322. X      begin
  1323. X        writeln('goBNum.KST not found');
  1324. X        raise gbFatal;
  1325. X      end;
  1326. X    sFID := FSLookup('goSNum.kst', sblks, bits);
  1327. X    if sFID = 0 then
  1328. X      begin
  1329. X        writeln('goSNum.KST not found');
  1330. X        raise gbFatal;
  1331. X      end;
  1332. X    tFID := FSLookup('goTNum.kst', tblks, bits);
  1333. X    if sFID = 0 then
  1334. X      begin
  1335. X        writeln('goTNum.KST not found');
  1336. X        raise gbFatal;
  1337. X      end;
  1338. X    lFID := FSLookup('goSLets.kst', lBlks, bits);
  1339. X    if lFID = 0 then
  1340. X      begin
  1341. X        writeln('goSLets.KST not found');
  1342. X        raise gbFatal;
  1343. X      end;
  1344. X    createSegment(fontseg, bblks + sblks + tBlks + lBlks, 1,
  1345. X                  bblks + sblks + tBlks + lBlks);
  1346. X    for i := 0 to bblks - 1 do
  1347. X      begin
  1348. X        bp := makePtr(fontSeg, i * 256, pDirBlk);
  1349. X        FSBlkRead(bFID, i, bp);
  1350. X      end;
  1351. X    goBNumFont := makePtr(fontseg, 0, fontPtr);
  1352. X    for i := 0 to sblks - 1 do
  1353. X      begin
  1354. X        bp := makePtr(fontSeg, (i + bblks) * 256, pDirBlk);
  1355. X        FSBlkRead(sFID, i, bp);
  1356. X      end;
  1357. X    goSNumFont := makePtr(fontseg, bblks * 256, fontPtr);
  1358. X    for i := 0 to tblks - 1 do
  1359. X      begin
  1360. X        bp := makePtr(fontSeg, (i + bblks + sBlks) * 256, pDirBlk);
  1361. X        FSBlkRead(tFID, i, bp);
  1362. X      end;
  1363. X    goTNumFont := makePtr(fontseg, (bblks  + sBlks) * 256, fontPtr);
  1364. X    for i := 0 to lBlks - 1 do
  1365. X      begin
  1366. X        bp := makePtr(fontSeg, (i + bblks + sBlks + tBlks) * 256, pDirBlk);
  1367. X        FSBlkRead(lFID, i, bp);
  1368. X      end;
  1369. X    goSLetFont := makePtr(fontseg, (bblks  + sBlks + tBlks) * 256, fontPtr);
  1370. X  end { setupFont };
  1371. X
  1372. Xbegin { initGoBoard }
  1373. X  printing := false;
  1374. X  beepInit;
  1375. X  definePats;
  1376. X  setupFont;
  1377. X  scrSavPtr := nil;
  1378. X  sNumBase := 0;
  1379. X  sNumStart := 0;
  1380. X  bigNums := false;
  1381. Xend. { initGoBoard }
  1382. X
  1383. END_OF_goBoard.pas
  1384. echo shar: 4 control characters may be missing from \"goBoard.pas\"
  1385. if test 38053 -ne `wc -c <goBoard.pas`; then
  1386.     echo shar: \"goBoard.pas\" unpacked with wrong size!
  1387. fi
  1388. # end of overwriting check
  1389. fi
  1390. if test -f goTree.pas -a "${1}" != "-c" ; then 
  1391.   echo shar: Will not over-write existing file \"goTree.pas\"
  1392. else
  1393. echo shar: Extracting \"goTree.pas\" \(19784 characters\)
  1394. sed "s/^X//" >goTree.pas <<'END_OF_goTree.pas'
  1395. X{---------------------------------------------------------------}
  1396. X{ GoTree.Pas                                                    }
  1397. X{                                                               }
  1398. X{ Go Game Tree Manager                                          }
  1399. X{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
  1400. X{                                                               }
  1401. X{ Written: June 3, 1982 by Stoney Ballard                       }
  1402. X{ Edit History:                                                 }
  1403. X{    June  3, 1982  Started                                     }
  1404. X{    June  4, 1982  Add dead group removal                      }
  1405. X{    June 10, 1982  Use new go file manager                     }
  1406. X{    Nov   9, 1982  Extracted from GO.PAS                       }
  1407. X{    Nov  15, 1982  Added tag and comment deletion              }
  1408. X{    Jan   5, 1983  Increased segment max sizes                 }
  1409. X{    Jan   7, 1983  Changed File Format to have global comment  }
  1410. X{---------------------------------------------------------------}
  1411. X
  1412. Xmodule goTree;
  1413. X
  1414. Xexports
  1415. X
  1416. Ximports goCom from goCom;
  1417. Ximports getTimeStamp from getTimeStamp;
  1418. X
  1419. Xtype
  1420. X  pMRec = ^moveRec;
  1421. X
  1422. X  tagStr = string[maxTagLen];
  1423. X  tagPtr = ^tagRec;
  1424. X  tagRec = record
  1425. X             mPtr: pMRec;
  1426. X             nextTag: tagPtr;
  1427. X             sTag: tagStr;
  1428. X           end;
  1429. X
  1430. X  mType = (header, move, remove, hcPlay, pass);
  1431. X  moveRec = packed record
  1432. X              mark: boolean;
  1433. X              flink: pMRec;
  1434. X              case id: mType of
  1435. X                header:
  1436. X                  (lastMove: pMRec;
  1437. X                   freePool: pMRec;
  1438. X                   lastTag: tagPtr;
  1439. X                   nextMRec: integer;
  1440. X                   nextMBlock: integer;
  1441. X                   nextTRec: integer;
  1442. X                   nextTBlock: integer;
  1443. X                   nextCIdx: integer;
  1444. X                   nextCBlock: integer;
  1445. X                   freeTags: tagPtr);
  1446. X                hcPlay, move, remove, pass:
  1447. X                  (blink: pMRec;
  1448. X                   slink: pMRec;
  1449. X                   tag: tagPtr;
  1450. X                   who: sType;
  1451. X                   moveN: integer;
  1452. X                   cmtBase: integer;
  1453. X                   cmtLen: integer;
  1454. X                   case {id:} mType of
  1455. X                     hcPlay:
  1456. X                       (hcNum: integer);
  1457. X                     move, remove:
  1458. X                       (mx: integer;
  1459. X                        my: integer;
  1460. X                        ox: integer;
  1461. X                        oy: integer;
  1462. X                        kx: integer;
  1463. X                        ky: integer) )
  1464. X            end;
  1465. X
  1466. X  baseBlock = packed record
  1467. X                case boolean of
  1468. X                  false:
  1469. X                    (padding: array[1..512] of char);
  1470. X                  true:
  1471. X                    (randBool: boolean;
  1472. X                     oldTest: pointer;
  1473. X                     fileVersion: integer;
  1474. X                     created: timeStamp;
  1475. X                     rootComment: string[127])
  1476. X              end;
  1477. X
  1478. X  pBaseBlock = ^baseBlock;
  1479. X
  1480. Xvar
  1481. X  treeRoot: pMRec;
  1482. X  stepTag: tagPtr;
  1483. X  hdrBlock: pBaseBlock;
  1484. X
  1485. Xexception goFNF;
  1486. Xexception badGoWrite;
  1487. Xexception badFileVersion;
  1488. X
  1489. Xprocedure initGoTree;
  1490. Xprocedure makeGoTree;
  1491. Xprocedure readTree(nam: string);
  1492. Xprocedure writeTree(nam: string; lm: pMRec);
  1493. Xfunction newMove(cm: pMRec): pMRec;
  1494. Xfunction delBranch(pm: pMRec): pMRec;
  1495. Xfunction hasAlts(pm: pMRec): boolean;
  1496. Xfunction isBranch(pm: pMRec): boolean;
  1497. Xfunction hasBranch(pm: pMRec): boolean;
  1498. Xfunction mergeMove(cm: pMRec): pMRec;
  1499. Xprocedure tagMove(cm: pMRec; ts: tagStr);
  1500. Xfunction tagExists(ts: tagStr): boolean;
  1501. Xprocedure commentMove(cm: pMRec; cs: string);
  1502. Xfunction getComment(cm: pMRec; var cs: string): boolean;
  1503. Xfunction getTag(cm: pMRec; var ts: string): boolean;
  1504. Xprocedure delTag(tp: tagPtr);
  1505. Xprocedure getFNameString(var fs: string);
  1506. X
  1507. Xprivate
  1508. X
  1509. Ximports fileSystem from fileSystem;
  1510. Ximports memory from memory;
  1511. Ximports perq_string from perq_string;
  1512. Ximports clock from clock;
  1513. X
  1514. Xconst
  1515. X  curFileVersion = 1;
  1516. X  minTreeSize = 20;
  1517. X  minTagSize = 4;
  1518. X  minCmtSize = 4;
  1519. X  maxTreeSize = 255;
  1520. X  maxTagSize = 64;
  1521. X  maxCmtSize = 128;
  1522. X  treeSegInc = 8;
  1523. X  tagSegInc = 4;
  1524. X  cmtSegInc = 4;
  1525. X
  1526. Xtype
  1527. X  caType = packed array[0..1] of char;
  1528. X  pCmtArray = ^caType;
  1529. X
  1530. Xvar
  1531. X  mFID: FileID;
  1532. X  treeSeg, tagSeg, cmtSeg: integer;
  1533. X  trSegSize, tagSegSize, cmtSegSize: integer;
  1534. X  cmtArray: pCmtArray;
  1535. X  cmtCmpArray: array[1..1024] of pMRec;
  1536. X
  1537. Xprocedure getFNameString(var fs: string);
  1538. Xvar
  1539. X  ts: string;
  1540. Xbegin  { getFNameString }
  1541. X  fs := gameFName;
  1542. X  if fs <> '' then
  1543. X    begin
  1544. X      stampToString(hdrBlock^.created, ts);
  1545. X      fs := concat(fs, '  ');
  1546. X      fs := concat(fs, ts);
  1547. X    end;
  1548. Xend { getFNameString };
  1549. X
  1550. Xfunction isBranch(pm: pMRec): boolean;
  1551. Xbegin { isBranch }
  1552. X  repeat
  1553. X    if pm = treeRoot then
  1554. X      begin
  1555. X        isBranch := false;
  1556. X        exit(isBranch);
  1557. X      end;
  1558. X    pm := pm^.blink;
  1559. X  until pm^.flink^.slink <> nil;
  1560. X  isBranch := true;
  1561. Xend { isBranch };
  1562. X
  1563. Xfunction hasBranch(pm: pMRec): boolean;
  1564. Xbegin { hasBranch }
  1565. X  while pm^.flink <> nil do
  1566. X    if pm^.flink^.slink <> nil then
  1567. X      begin
  1568. X        hasBranch := true;
  1569. X        exit(hasBranch);
  1570. X      end
  1571. X    else
  1572. X      pm := pm^.flink;
  1573. X  hasBranch := false;
  1574. Xend { hasBranch };
  1575. X
  1576. Xprocedure initSegs(trSize, tagSize, cmtSize: integer);
  1577. Xbegin { initSegs }
  1578. X  if treeSeg <> -1 then
  1579. X    begin
  1580. X      changeSize(treeSeg, trSize);
  1581. X      changeSize(tagSeg, tagSize);
  1582. X      changeSize(cmtSeg, cmtSize);
  1583. X    end
  1584. X  else
  1585. X    begin
  1586. X      createSegment(treeSeg, trSize, treeSegInc, maxTreeSize);
  1587. X      createSegment(tagSeg, tagSize, tagSegInc, maxTagSize);
  1588. X      createSegment(cmtSeg, cmtSize, cmtSegInc, maxCmtSize);
  1589. X    end;
  1590. X  trSegSize := trSize;
  1591. X  tagSegSize := tagSize;
  1592. X  cmtSegSize := cmtSize;
  1593. Xend { initSegs };
  1594. X
  1595. Xprocedure initHdrBlock;
  1596. Xbegin { initHdrBlock }
  1597. X  with hdrBlock^ do
  1598. X    begin
  1599. X      oldTest := nil;
  1600. X      fileVersion := curFileVersion;
  1601. X      getTStamp(created);
  1602. X      rootComment := '';
  1603. X    end;
  1604. Xend { initHdrBlock };
  1605. X
  1606. Xprocedure makeGoTree;
  1607. Xbegin { makeGoTree }
  1608. X  initSegs(minTreeSize, minTagSize, minCmtSize);
  1609. X  initHdrBlock;
  1610. X  treeRoot := makePtr(treeSeg, 0, pMRec);
  1611. X  with treeRoot^ do
  1612. X    begin
  1613. X      id := header;
  1614. X      freePool := nil;
  1615. X      flink := nil;
  1616. X      lastTag := nil;
  1617. X      nextMRec := wordSize(moveRec);
  1618. X      nextMBlock := minTreeSize * 256;
  1619. X      nextTRec := 0;
  1620. X      nextTBlock := minTagSize * 256;
  1621. X      nextCIdx := 0;
  1622. X      nextCBlock := minCmtSize * 512;
  1623. X      freeTags := nil;
  1624. X    end;
  1625. X  cmtArray := makePtr(cmtSeg, 0, pCmtArray);
  1626. X  stepTag := nil;
  1627. Xend { makeGoTree };
  1628. X
  1629. Xprocedure readTree(nam: string);
  1630. Xtype
  1631. X   ptrHack = record
  1632. X               case integer of
  1633. X                 0: (p: pMRec);
  1634. X                 1: (pt: tagPtr);
  1635. X                 2: (po: integer;
  1636. X                     ps: integer);
  1637. X             end;
  1638. Xvar
  1639. X  size, gbg, i, b: integer;
  1640. X  pd: pDirBlk;
  1641. X  ph: ptrHack;
  1642. X  pm: pMRec;
  1643. X  tm: tagPtr;
  1644. X  mBlks, tBlks, cBlks: integer;
  1645. Xbegin { readTree }
  1646. X  initSegs(minTreeSize, minTagSize, minCmtSize);
  1647. X  mFID := FSLookup(nam, size, gbg);
  1648. X  if mFID = 0 then
  1649. X    raise goFNF;
  1650. X  FSBlkRead(mFID, 0, recast(hdrBlock, pDirBlk));
  1651. X  if hdrBlock^.oldTest <> nil then
  1652. X    begin
  1653. X      initHdrBlock;
  1654. X      b := 0;
  1655. X    end
  1656. X  else if hdrBlock^.fileVersion <> curFileVersion then
  1657. X    begin
  1658. X      makeGoTree;
  1659. X      raise badFileVersion;
  1660. X    end
  1661. X  else
  1662. X    b := 1;
  1663. X  pd := makePtr(treeSeg, 0, pDirBlk);
  1664. X  FSBlkRead(mFID, b, pd);
  1665. X  b := b + 1;
  1666. X  treeRoot := makePtr(treeSeg, 0, pMRec);
  1667. X  with treeRoot^ do
  1668. X    begin
  1669. X      mBlks := nextMBlock div 256;
  1670. X      tBlks := nextTBlock div 256;
  1671. X      cBlks := nextCBlock div 512;
  1672. X    end;
  1673. X  initSegs(mBlks, tBlks, cBlks);
  1674. X  for i := 1 to mBlks - 1 do
  1675. X    begin
  1676. X      pd := makePtr(treeSeg, i * 256, pDirBlk);
  1677. X      FSBlkRead(mFID, b, pd);
  1678. X      b := b + 1;
  1679. X    end;
  1680. X  for i := 0 to tBlks - 1 do
  1681. X    begin
  1682. X      pd := makePtr(tagSeg, i * 256, pDirBlk);
  1683. X      FSBlkRead(mFID, b, pd);
  1684. X      b := b + 1;
  1685. X    end;
  1686. X  for i := 0 to cBlks - 1 do
  1687. X    begin
  1688. X      pd := makePtr(cmtSeg, i * 256, pDirBlk);
  1689. X      FSBlkRead(mFID, b, pd);
  1690. X      b := b + 1;
  1691. X    end;
  1692. X  with treeRoot^ do
  1693. X    begin
  1694. X      if freePool <> nil then
  1695. X        begin
  1696. X          ph.p := freePool;
  1697. X          ph.ps := treeSeg;
  1698. X          freePool := ph.p;
  1699. X        end;
  1700. X      if flink <> nil then
  1701. X        begin
  1702. X          ph.p := flink;
  1703. X          ph.ps := treeSeg;
  1704. X          flink := ph.p;
  1705. X        end;
  1706. X      if lastMove <> nil then
  1707. X        begin
  1708. X          ph.p := lastMove;
  1709. X          ph.ps := treeSeg;
  1710. X          lastMove := ph.p;
  1711. X        end;
  1712. X      if lastTag <> nil then
  1713. X        begin
  1714. X          ph.pt := lastTag;
  1715. X          ph.ps := tagSeg;
  1716. X          lastTag := ph.pt;
  1717. X        end;
  1718. X      if freeTags <> nil then
  1719. X        begin
  1720. X          ph.pt := freeTags;
  1721. X          ph.ps := tagSeg;
  1722. X          freeTags := ph.pt;
  1723. X        end;
  1724. X    end;
  1725. X  i := wordSize(moveRec);
  1726. X  while i < treeRoot^.nextMRec do
  1727. X    begin
  1728. X      pm := makePtr(treeSeg, i, pMRec);
  1729. X      with pm^ do
  1730. X        begin
  1731. X          if flink <> nil then
  1732. X            begin
  1733. X              ph.p := flink;
  1734. X              ph.ps := treeSeg;
  1735. X              flink := ph.p;
  1736. X            end;
  1737. X          if blink <> nil then
  1738. X            begin
  1739. X              ph.p := blink;
  1740. X              ph.ps := treeSeg;
  1741. X              blink := ph.p;
  1742. X            end;
  1743. X          if slink <> nil then
  1744. X            begin
  1745. X              ph.p := slink;
  1746. X              ph.ps := treeSeg;
  1747. X              slink := ph.p;
  1748. X            end;
  1749. X          if tag <> nil then
  1750. X            begin
  1751. X              ph.pt := tag;
  1752. X              ph.ps := tagSeg;
  1753. X              tag := ph.pt;
  1754. X            end;
  1755. X        end;
  1756. X      i := i + wordSize(moveRec);
  1757. X    end;
  1758. X  i := 0;
  1759. X  while i < treeRoot^.nextTRec do
  1760. X    begin
  1761. X      tm := makePtr(tagSeg, i, tagPtr);
  1762. X      with tm^ do
  1763. X        begin
  1764. X          if mPtr <> nil then
  1765. X            begin
  1766. X              ph.p := mPtr;
  1767. X              ph.ps := treeSeg;
  1768. X              mPtr := ph.p;
  1769. X            end;
  1770. X          if nextTag <> nil then
  1771. X            begin
  1772. X              ph.pt := nextTag;
  1773. X              ph.ps := tagSeg;
  1774. X              nextTag := ph.pt;
  1775. X            end;
  1776. X        end;
  1777. X      i := i + wordSize(tagRec);
  1778. X    end;
  1779. X  stepTag := nil;
  1780. Xend { readTree };
  1781. X
  1782. Xprocedure writeTree(nam: string; lm: pMRec);
  1783. Xvar
  1784. X  pd: pDirBlk;
  1785. X  treeBlks, tagBlks, cmtBlks: integer;
  1786. X  b, i: integer;
  1787. X
  1788. X  procedure compressCmts;
  1789. X  var
  1790. X    numCmts: integer;
  1791. X    cp: pMRec;
  1792. X
  1793. X    procedure spanComments(m: pMRec);
  1794. X    begin { spanComments }
  1795. X      while m <> nil do
  1796. X        begin
  1797. X          if m^.cmtLen > 0 then
  1798. X            begin
  1799. X              numCmts := numCmts + 1;
  1800. X              cmtCmpArray[numCmts] := m;
  1801. X            end;
  1802. X          spanComments(m^.slink);
  1803. X          m := m^.flink;
  1804. X        end;
  1805. X    end { spanComments };
  1806. X
  1807. X    procedure sortComments;
  1808. X    var
  1809. X      i, j: integer;
  1810. X      t: pMRec;
  1811. X    begin { sortComments }
  1812. X      for i := 1 to numCmts - 1 do
  1813. X        for j := i + 1 to numCmts do
  1814. X          if cmtCmpArray[i]^.cmtBase > cmtCmpArray[j]^.cmtBase then
  1815. X            begin
  1816. X              t := cmtCmpArray[i];
  1817. X              cmtCmpArray[i] := cmtCmpArray[j];
  1818. X              cmtCmpArray[j] := t;
  1819. X            end;
  1820. X    end { sortComments };
  1821. X
  1822. X    procedure squeezeComments;
  1823. X    var
  1824. X      i, j, cgi, lastCB: integer;
  1825. X      mp: pMRec;
  1826. X    begin { squeezeComments }
  1827. X      lastCB := 0;
  1828. X      for i := 1 to numCmts do
  1829. X        begin
  1830. X          if cmtCmpArray[i]^.cmtBase > lastCB then
  1831. X            begin
  1832. X              cgi := cmtCmpArray[i]^.cmtBase;
  1833. X              for j := 0 to cmtCmpArray[i]^.cmtLen - 1 do
  1834. X                begin
  1835. X    {$R-}
  1836. X                  cmtArray^[lastCB + j] := cmtArray^[cgi + j];
  1837. X    {$R=}
  1838. X                end;
  1839. X              cmtCmpArray[i]^.cmtBase := lastCB;
  1840. X            end;
  1841. X          lastCB := cmtCmpArray[i]^.cmtBase + cmtCmpArray[i]^.cmtLen;
  1842. X        end;
  1843. X      treeRoot^.nextCIdx := lastCB;
  1844. X    end { squeezeComments };
  1845. X
  1846. X  begin { compressCmts }
  1847. X    numCmts := 0;
  1848. X    cp := treeRoot^.flink;
  1849. X    if cp <> nil then
  1850. X      begin
  1851. X        spanComments(cp);
  1852. X        sortComments;
  1853. X        squeezeComments;
  1854. X      end;
  1855. X  end { compressCmts };
  1856. X
  1857. Xbegin { writeTree }
  1858. X  mFID := FSEnter(nam);
  1859. X  if mFID = 0 then
  1860. X    raise badGoWrite
  1861. X  else
  1862. X    begin
  1863. X      compressCmts;
  1864. X      with treeRoot^ do
  1865. X        begin
  1866. X          lastMove := lm;
  1867. X          treeBlks := nextMBlock div 256;
  1868. X          tagBlks := nextTBlock div 256;
  1869. X          cmtBlks := nextCBlock div 512;
  1870. X        end;
  1871. X      FSBlkWrite(mFID, 0, recast(hdrBlock, pDirBlk));
  1872. X      b := 1;
  1873. X      for i := 0 to treeBlks - 1 do
  1874. X        begin
  1875. X          pd := makePtr(treeSeg, i * 256, pDirBlk);
  1876. X          FSBlkWrite(mFID, b, pd);
  1877. X          b := b + 1;
  1878. X        end;
  1879. X      for i := 0 to tagBlks - 1 do
  1880. X        begin
  1881. X          pd := makePtr(tagSeg, i * 256, pDirBlk);
  1882. X          FSBlkWrite(mFID, b, pd);
  1883. X          b := b + 1;
  1884. X        end;
  1885. X      for i := 0 to cmtBlks - 1 do
  1886. X        begin
  1887. X          pd := makePtr(cmtSeg, i * 256, pDirBlk);
  1888. X          FSBlkWrite(mFID, b, pd);
  1889. X          b := b + 1;
  1890. X        end;
  1891. X      FSClose(mFID, treeBlks + tagBlks + cmtBlks, 4096);
  1892. X    end;
  1893. Xend { writeTree };
  1894. X
  1895. Xfunction newMove(cm: pMRec): pMRec;
  1896. Xvar
  1897. X  pm: pMRec;
  1898. Xbegin { newMove }
  1899. X  with treeRoot^ do
  1900. X    if freePool <> nil then
  1901. X      begin
  1902. X        pm := freePool;
  1903. X        freePool := pm^.flink;
  1904. X      end
  1905. X    else
  1906. X      begin
  1907. X        if nextMRec + wordSize(moveRec) > nextMBlock then
  1908. X          begin
  1909. X            trSegSize := trSegSize + treeSegInc;
  1910. X            changeSize(treeSeg, trSegSize);
  1911. X            nextMBlock := nextMBlock + (treeSegInc * 256);
  1912. X          end;
  1913. X        pm := makePtr(treeSeg, nextMRec, pMRec);
  1914. X        nextMRec := nextMRec + wordSize(moveRec);
  1915. X      end;
  1916. X  with pm^ do
  1917. X    begin
  1918. X      flink := nil;
  1919. X      blink := cm;
  1920. X      slink := nil;
  1921. X      tag := nil;
  1922. X      cmtLen := 0;
  1923. X    end;
  1924. X  if cm^.flink <> nil then
  1925. X    pm^.slink := cm^.flink;
  1926. X  cm^.flink := pm;
  1927. X  newMove := pm;
  1928. Xend { newMove };
  1929. X
  1930. Xprocedure tagMove(cm: pMRec; ts: tagStr);
  1931. Xvar
  1932. X  tp: tagPtr;
  1933. Xbegin { tagMove }
  1934. X  if cm^.tag <> nil then
  1935. X    cm^.tag^.sTag := ts
  1936. X  else
  1937. X    with treeRoot^ do
  1938. X      begin
  1939. X        if freeTags <> nil then
  1940. X          begin
  1941. X            tp := freeTags;
  1942. X            freeTags := tp^.nextTag;
  1943. X          end
  1944. X        else
  1945. X          begin
  1946. X            if nextTRec + wordSize(tagRec) > nextTBlock then
  1947. X              begin
  1948. X                tagSegSize := tagSegSize + tagSegInc;
  1949. X                changeSize(tagSeg, tagSegSize);
  1950. X                nextTBlock := nextTBlock + (tagSegInc * 256);
  1951. X              end;
  1952. X            tp := makePtr(tagSeg, nextTRec, tagPtr);
  1953. X            nextTRec := nextTRec + wordSize(tagRec);
  1954. X          end;
  1955. X        cm^.tag := tp;
  1956. X        with tp^ do
  1957. X          begin
  1958. X            mPtr := cm;
  1959. X            nextTag := lastTag;
  1960. X            sTag := ts;
  1961. X          end;
  1962. X        lastTag := tp;
  1963. X      end;
  1964. X  treeDirty := true;
  1965. Xend { tagMove };
  1966. X
  1967. Xfunction tagExists(ts: tagStr): boolean;
  1968. Xvar
  1969. X  tp: tagPtr;
  1970. X
  1971. X  function upCmp(s1, s2: pString): boolean;
  1972. X  begin { upCmp }
  1973. X    convUpper(s1);
  1974. X    convUpper(s2);
  1975. X    upCmp := s1 = s2;
  1976. X  end { upCmp };
  1977. X
  1978. Xbegin { tagExists }
  1979. X  tp := treeRoot^.lastTag;
  1980. X  while tp <> nil do
  1981. X    if upCmp(tp^.sTag, ts) then
  1982. X      begin
  1983. X        tagExists := true;
  1984. X        exit(tagExists);
  1985. X      end
  1986. X    else
  1987. X      tp := tp^.nextTag;
  1988. X  tagExists := false;
  1989. Xend { tagExists };
  1990. X
  1991. Xprocedure commentMove(cm: pMRec; cs: string);
  1992. Xvar
  1993. X  sl, i: integer;
  1994. Xbegin { commentMove }
  1995. X  if cm = treeRoot then
  1996. X    hdrBlock^.rootComment := cs
  1997. X  else
  1998. X    begin
  1999. X      sl := length(cs);
  2000. X      with cm^ do
  2001. X        begin
  2002. X          cmtLen := sl;
  2003. X          if sl > 0 then
  2004. X            begin
  2005. X              cmtBase := treeRoot^.nextCIdx;
  2006. X              treeRoot^.nextCIdx := cmtBase + sl;
  2007. X              if cmtBase + cmtLen > treeRoot^.nextCBlock then
  2008. X                with treeRoot^ do
  2009. X                  begin
  2010. X                    cmtSegSize := cmtSegSize + cmtSegInc;
  2011. X                    changeSize(cmtSeg, cmtSegSize);
  2012. X                    nextCBlock := nextCBlock + (cmtSegInc * 512);
  2013. X                  end;
  2014. X              for i := 0 to sl - 1 do
  2015. X                begin
  2016. X{$R-}
  2017. X                  cmtArray^[cmtBase + i] := cs[i + 1];
  2018. X{$R=}
  2019. X                end;
  2020. X            end;
  2021. X        end;
  2022. X    end;
  2023. X  treeDirty := true;
  2024. Xend { commentMove };
  2025. X
  2026. Xfunction getComment(cm: pMRec; var cs: string): boolean;
  2027. Xvar
  2028. X  i: integer;
  2029. Xbegin { getComment }
  2030. X  if cm = treeRoot then
  2031. X    begin
  2032. X      cs := hdrBlock^.rootComment;
  2033. X      getComment := cs <> '';
  2034. X    end
  2035. X  else if cm^.cmtLen = 0 then
  2036. X    getComment := false
  2037. X  else
  2038. X    with cm^ do
  2039. X      begin
  2040. X        getComment := true;
  2041. X        adjust(cs, cmtLen);
  2042. X        for i := 1 to cmtLen do
  2043. X          begin
  2044. X{$R-}
  2045. X            cs[i] := cmtArray^[cmtBase + i - 1];
  2046. X{$R=}
  2047. X          end;
  2048. X      end;
  2049. Xend { getComment };
  2050. X
  2051. Xfunction getTag(cm: pMRec; var ts: string): boolean;
  2052. Xbegin { getTag }
  2053. X  if cm = treeRoot then
  2054. X    getTag := false
  2055. X  else if cm^.tag = nil then
  2056. X    getTag := false
  2057. X  else
  2058. X    begin
  2059. X      ts := cm^.tag^.sTag;
  2060. X      getTag := true;
  2061. X    end;
  2062. Xend { getTag };
  2063. X
  2064. Xprocedure delTag(tp: tagPtr);
  2065. Xvar
  2066. X  ttp: tagPtr;
  2067. Xbegin { delTag }
  2068. X  tp^.mPtr^.tag := nil;
  2069. X  tp^.mPtr := nil;
  2070. X  if stepTag = tp then
  2071. X    stepTag := nil;
  2072. X  ttp := treeRoot^.lastTag;
  2073. X  if ttp = tp then
  2074. X    treeRoot^.lastTag := tp^.nextTag
  2075. X  else
  2076. X    begin
  2077. X      while ttp^.nextTag <> tp do
  2078. X        ttp := ttp^.nextTag;
  2079. X      ttp^.nextTag := tp^.nextTag;
  2080. X    end;
  2081. X  tp^.nextTag := treeRoot^.freeTags;
  2082. X  treeRoot^.freeTags := tp;
  2083. Xend { delTag };
  2084. X
  2085. Xfunction delBranch(pm: pMRec): pMRec;
  2086. Xvar
  2087. X  sm: pMRec;
  2088. X
  2089. X  procedure recDel(m: pMRec);
  2090. X  var
  2091. X    tp: tagPtr;
  2092. X  begin { recDel }
  2093. X    if m <> nil then
  2094. X      begin
  2095. X        recDel(m^.slink);
  2096. X        recDel(m^.flink);
  2097. X        m^.blink := nil;
  2098. X        m^.slink := nil;
  2099. X        m^.flink := treeRoot^.freePool;
  2100. X        treeRoot^.freePool := m;
  2101. X        if m^.tag <> nil then
  2102. X          delTag(m^.tag);
  2103. X      end;
  2104. X  end { recDel };
  2105. X
  2106. Xbegin { delBranch }
  2107. X  if pm = treeRoot then
  2108. X    exit(delBranch);
  2109. X  while pm^.id = remove do
  2110. X    pm := pm^.blink;
  2111. X  if pm^.blink^.flink = pm then
  2112. X    pm^.blink^.flink := pm^.slink
  2113. X  else
  2114. X    begin
  2115. X      sm := pm^.blink^.flink;
  2116. X      while sm^.slink <> pm do
  2117. X        sm := sm^.slink;
  2118. X      sm^.slink := pm^.slink;
  2119. X    end;
  2120. X  pm^.slink := nil;
  2121. X  delBranch := pm^.blink;
  2122. X  pm^.blink := nil;
  2123. X  recDel(pm);
  2124. Xend { delBranch };
  2125. X
  2126. Xprocedure delNode(pm: pMRec);
  2127. Xvar
  2128. X  sm: pMRec;
  2129. Xbegin { delNode }
  2130. X  if pm = treeRoot then
  2131. X    exit(delNode);
  2132. X  if pm^.blink^.flink = pm then
  2133. X    pm^.blink^.flink := pm^.slink
  2134. X  else
  2135. X    begin
  2136. X      sm := pm^.blink^.flink;
  2137. X      while sm^.slink <> pm do
  2138. X        sm := sm^.slink;
  2139. X      sm^.slink := pm^.slink;
  2140. X    end;
  2141. X  pm^.blink := nil;
  2142. X  pm^.slink := nil;
  2143. X  pm^.flink := treeRoot^.freePool;
  2144. X  treeRoot^.freePool := pm;
  2145. Xend { delNode };
  2146. X
  2147. Xfunction mergeMove(cm: pMRec): pMRec;
  2148. Xvar
  2149. X  tm: pMRec;
  2150. Xbegin { mergeMove }
  2151. X  tm := cm^.blink^.flink;
  2152. X  mergeMove := cm;
  2153. X  while tm <> nil do
  2154. X    begin
  2155. X      if tm <> cm then
  2156. X        with tm^ do
  2157. X          if id = cm^.id then
  2158. X            if id = hcPlay then
  2159. X              begin
  2160. X                mergeMove := tm;
  2161. X                delNode(cm);
  2162. X                exit(mergeMove);
  2163. X              end            
  2164. X            else if id = pass then
  2165. X              begin
  2166. X                if who = cm^.who then
  2167. X                  begin
  2168. X                    mergeMove := tm;
  2169. X                    delNode(cm);
  2170. X                    exit(mergeMove);
  2171. X                  end;
  2172. X              end
  2173. X            else if (mx = cm^.mx) and
  2174. X               (my = cm^.my) and
  2175. X               (who = cm^.who) then
  2176. X              begin
  2177. X                mergeMove := tm;
  2178. X                delNode(cm);
  2179. X                exit(mergeMove);
  2180. X              end;
  2181. X      tm := tm^.slink;
  2182. X    end;
  2183. X  treeDirty := true;
  2184. Xend { mergeMove };
  2185. X
  2186. Xfunction hasAlts(pm: pMRec): boolean;
  2187. Xbegin { hasAlts }
  2188. X  while pm^.id = remove do
  2189. X    pm := pm^.blink;
  2190. X  hasAlts := pm^.blink^.flink^.slink <> nil;
  2191. Xend { hasAlts };
  2192. X
  2193. Xprocedure initGoTree;
  2194. Xbegin { initGoTree }
  2195. X  treeSeg := -1;
  2196. X  new(0, 256, hdrBlock);
  2197. Xend. { initGoTree }
  2198. END_OF_goTree.pas
  2199. if test 19784 -ne `wc -c <goTree.pas`; then
  2200.     echo shar: \"goTree.pas\" unpacked with wrong size!
  2201. fi
  2202. # end of overwriting check
  2203. fi
  2204. echo shar: End of archive 3 \(of 5\).
  2205. cp /dev/null ark3isdone
  2206. MISSING=""
  2207. for I in 1 2 3 4 5 ; do
  2208.     if test ! -f ark${I}isdone ; then
  2209.     MISSING="${MISSING} ${I}"
  2210.     fi
  2211. done
  2212. if test "${MISSING}" = "" ; then
  2213.     echo You have unpacked all 5 archives.
  2214.     rm -f ark[1-9]isdone
  2215. else
  2216.     echo You still need to unpack the following archives:
  2217.     echo "        " ${MISSING}
  2218. fi
  2219. ##  End of shell archive.
  2220. exit 0
  2221.